﻿namespace CSP

module Problem =

    open CSP.Domain

    /// Binary constraint.
    type constr<'k,'a> = 'k * ('a -> 'a -> bool) * 'k

    /// Binary CSP.
    type problem<'k, 'a> when 'k: comparison = { Domains: Map<'k,'a domain>; Constraints: constr<'k,'a> list }

    let internal domains problem = problem.Domains
    let internal constraints problem = problem.Constraints

    /// Creates a binary CSP from domains and constraints.
    let create domains constraints = { Domains = domains; Constraints = constraints }

    /// Creates an empty binary CSP, i.e. one without domains and constraints.
    let empty() = create Map.empty []

    /// Adds a domain to a binary CSP. 
    let addDomain key domain problem = create (problem |> domains |> Map.add key domain) (constraints problem)

    /// Adds a constraint to a binary CSP.
    let addConstraint left constr right problem = 
        create 
            (domains problem) 
            ((left, constr, right) :: constraints problem)

    let internal solution problem = problem |> domains |> Map.map (fun _ d -> single d)

    type internal state<'k,'a> when 'k: comparison =
        | Contradiction
        | Solution of Map<'k,'a>
        | Ambiguous of ('k * 'a domain) list

    let internal state problem =
        let rec s (ds: (_ * _ domain) list) acc =
            match ds with
                | [] -> if acc = [] then Solution (solution problem) else Ambiguous acc
                | (k,d)::ds' -> let count = count d
                                if count = 0 then Contradiction
                                elif count = 1 then s ds' acc
                                else s ds' ((k,d)::acc)
        s (problem |> domains |> Map.toList) []

    let internal split key problem =
        let ds = domains problem
        let cs = constraints problem
        let d = Map.find key ds
        let d', d'' = split d
        let ds' = Map.add key d' ds
        let ds'' = Map.add key d'' ds
        (create ds' cs), (create ds'' cs)